(FILECREATED " 2-NOV-73  4:03:21" S-EXPLAIN)


  (LISPXPRINT (QUOTE EXPLAINVARS)
              T)
  (RPAQQ EXPLAINVARS
         ((* Everything needed to do an "EXPLAIN" command)
          (FNS EXPLAIN PRINCL COLLNUMLIST BONDING PRINU PRINMB 
               PRINNUMLIS PRINNUMLISTS)
          (FNS EXPLAINATIONMOLECULES EXPLAINGENMOL EXPLAINRINGS 
               EXPLAINSTRUCWAT EXPLAINRINGSKEL EXPLAINATTACFVS 
               EXPLAINNOFV EXPLAINNOLOOP EXPLAINCAT EXPLAINATTBIV 
               EXPLAINVL EXPLAINBVL)
          (VARS (EXPLAININDENT 0)
                (EXPLAINLEVEL 0))
          (PROP EXPLAINATION MOLECULES GENMOL RINGS STRUCTURESWITHATOMS 
                RINGSKELETONS ATTACHFVS NOFVRINGS NOLOOPEDRINGS CATALOG 
                ATTACHBIVALENTS ATTACHBIVS&LOOPS)
          (USERMACROS EXPLAINALL EXPLAIN EL ⊗)))

(* Everything needed to do an "EXPLAIN" command)

(DEFINEQ

(EXPLAIN
  [LAMBDA (FORM PREFIX)
    (PROG [(EXPLAININDENT (COND
                            (EXPLAININDENT (TAB EXPLAININDENT)
                                           (IPLUS 5 EXPLAININDENT))
                            (T 5)))
           (EXPLAINLEVEL (COND
                           (EXPLAINLEVEL (SUB1 EXPLAINLEVEL))
                           (T 30]
          (COND
            (PREFIX (MAPRINT PREFIX T NIL " " "")))
          (COND
            [(STRUCLIST? FORM)
              (COND
                ((ILESSP EXPLAINLEVEL 1)
                  (PROG (FORMS LISTS OTHER STRUCS RADS FLG)
                        [FOR X IN (fetch LISTITEMS of FORM)
                           AS I
                           FROM 1
                           DO (COND
                                ((STRUCLIST? X)
                                  (SETQ LISTS (CONS I LISTS)))
                                ((STRUCFORM? X)
                                  (SETQ FORMS (CONS I FORMS)))
                                ((STRUCTURE? X)
                                  (SETQ STRUCS (CONS I STRUCS)))
                                ((RADICAL? X)
                                  (SETQ RADS (CONS I RADS)))
                                (T (SETQ OTHER (CONS I OTHER]
                        (PRINNUMLISTS
                          FORMS "forms:" LISTS "sublists:" STRUCS 
                          "structures:" RADS "radicals:" OTHER 
                          "garbage:")))
                (T (PRIN1 "List with:" T)
                   (FOR X IN (fetch LISTITEMS of FORM) AS I
                      FROM 1
                      DO (EXPLAIN X (LIST "#" I)))
                   (TERPRI T]
            [(STRUCFORM? FORM)
              (COND
                ([OR (ILESSP EXPLAINLEVEL 1)
                     (NOT (GETP (CADR FORM)
                                (QUOTE EXPLAINATION]
                  (PRIN1 (CADR FORM)
                         T)
                  (PRIN1 " expression." T))
                (T (APPLY (GETP (CADR FORM)
                                (QUOTE EXPLAINATION))
                          (CDDR FORM]
            [(OR (STRUCTURE? FORM)
                 (RADICAL? FORM))
              (COND
                ((ILESSP EXPLAINLEVEL 1)
                  (PRIN1 (COND
                           ((STRUCTURE? FORM)
                             "structure.")
                           (T "radical."))
                         T))
                [(EQ (fetch LASTNODE# of FORM)
                     2)
                  (PRINMB (ATOMTYPE (CAR (fetch CTABLE of FORM)))
                          (FOR X
                             IN (fetch NBRS of
                                       (CAR (fetch CTABLE of FORM)))
                             WHEN (NOT (EQ X (QUOTE FV)))
                             SUM 1)
                          (ATOMTYPE (CADR (fetch CTABLE of FORM]
                (T (PRIN1 "The structure:
" T)
                   (DRAW FORM)
                   (TERPRI T]
            (T (PRIN1 ", garbage." T])

(PRINCL
  [LAMBDA (CL)
    (SORT CL T)
    (PROG (FLG TEM BFLG)
          (FOR X IN CL
             DO (PROG NIL
                      [SETQ TEM (COND
                          ((ATOM (CAR X))
                            (CAR X))
                          ((NOT (CDAR X))
                            (CAAR X))
                          ((AND (ATOM (CAAR X))
                                (GETP (CAAR X)
                                      (QUOTE VALENCE)))
                            (CAAR X))
                          (T (AND FLG (NEQ FLG (QUOTE FOO))
                                  (PRIN1 " and" T))
                             (SETQQ FLG FOO)
                             (EXPLAIN (CAR X)
                                      (LIST (CDR X)))
                             (GO BYPASS]
                      (AND FLG (PRIN1 (QUOTE ", ")
                                      T))
                      (SETQ FLG T)
                      (SPACES 1 T)
                      (PRIN1 (CDR X)
                             T)
                      (SPACES 1 T)
                      (PRIN1 TEM T)
                  BYPASS
                      (AND (IGREATERP (CDR X)
                                      1)
                           (PRIN1 (QUOTE "'s ")
                                  T])

(COLLNUMLIST
  [LAMBDA (X)
    (SETQ X (REVERSE X))
    (PROG (LST RES)
          [SETQ RES (LIST (SETQ LST (CAR X]
          [FOR OLD X ON (CDR X) AS FLG IS NIL
             DO (FOR OLD X ON X WHILE (EQ (CAR X)
                                          (SETQ LST (ADD1 LST)))
                   DO (SETQ FLG (CAR X)))
                (COND
                  (FLG (NCONC1 RES "-")
                       (NCONC1 RES FLG)))
                (COND
                  (X (NCONC1 RES ",")
                     (NCONC1 RES (SETQ LST (CAR X]
          (RETURN (LIST (APPLY (QUOTE CONCAT)
                               RES])

(BONDING
  [LAMBDA (U)
    (SELECTQ U
             (1 "-")
             (2 "=")
             (3 ":::")
             (CONCAT "-" U "-"])

(PRINU
  [LAMBDA (U)
    (PRIN1 U T)
    (PRIN1 (SELECTQ U
                    (1 " unsaturation, ")
                    " unsaturations, "])

(PRINMB
  [LAMBDA (AT BND AT2)
    (PRIN1 (OR AT "@")
           T)
    (PRIN1 (BONDING BND)
           T)
    (PRIN1 (OR AT2 "@")
           T)
    (SPACES 1 T])

(PRINNUMLIS
  [LAMBDA (X)
    (SETQ X (REVERSE X))
    (PROG (LST)
          (PRIN1 (SETQ LST (CAR X))
                 T)
          (FOR OLD X ON (CDR X) AS FLG IS NIL
             DO (FOR OLD X ON X WHILE (EQ (CAR X)
                                          (SETQ LST (ADD1 LST)))
                   DO (SETQ FLG (CAR X)))
                (COND
                  (FLG (PRIN1 "-" T)
                       (PRIN1 FLG T)))
                (COND
                  (X (PRIN1 "," T)
                     (PRIN1 (SETQ LST (CAR X))
                            T])

(PRINNUMLISTS
  [LAMBDA N
    (PROG (FLG)
          (FOR I FROM 1 TO N BY 2
             DO (COND
                  ((ARG N I)
                    (AND FLG (PRIN1 ", " T))
                    (SETQ FLG T)
                    (PRIN1 (ARG N (ADD1 I))
                           T)
                    (PRINNUMLIS (ARG N I])
)
(DEFINEQ

(EXPLAINATIONMOLECULES
  [LAMBDA (CL U)
    (PRIN1 (QUOTE "Molecules with ")
           T)
    (PRINU U)
    (PRINCL CL])

(EXPLAINGENMOL
  [LAMBDA (CL)
    (PRIN1 (QUOTE "all tree structures constructed out of ")
           T)
    (PRINCL CL])

(EXPLAINRINGS
  [LAMBDA (U CL)
    (COND
      ((EQ (CLCOUNT CL)
           2)
        (SETQ CL (CLEXPAND CL))
        (PRINMB (CAR CL)
                (ADD1 U)
                (CADR CL)))
      (T (PRIN1 "Purely cyclic structures with " T)
         (PRINU U)
         (PRINCL CL])

(EXPLAINSTRUCWAT
  [LAMBDA (CLL STRUC)
    (PRINCL (APPLY (QUOTE APPEND)
                   CLL))
    (PRIN1 (QUOTE " placed on ")
           T)
    (EXPLAIN STRUC])

(EXPLAINRINGSKEL
  [LAMBDA (FV VL)
    (PRIN1 "Ring skeletons with " T)
    (PRIN1 FV T)
    (PRIN1 " free valences" T)
    (FOR X IN VL AS I FROM 2 WHEN (NOT (ZEROP X))
       DO (PRIN1 (QUOTE ", ")
                 T)
          (PRIN1 X T)
          (PRIN1 " nodes of valence " T)
          (PRIN1 I T])

(EXPLAINATTACFVS
  [LAMBDA (FVL STRUC)
    (EXPLAIN STRUC)
    (PRIN1 ", with " T)
    (PROG (FLG)
          (FOR FVR IN FVL AS VALNODE FROM 2 FOR FVI IN FVR
             AS NUMFV
             FROM 1
             WHEN (NOT (ZEROP FVI))
             DO (AND FLG (PRIN1 ", " T))
                (SETQ FLG T)
                (PRIN1 FVI T)
                (PRIN1 " of the " T)
                (PRIN1 (SELECTQ VALNODE
                                (1 "uni")
                                (2 "bi")
                                (3 "tri")
                                (4 "quadri")
                                VALNODE)
                       T)
                (PRIN1 "-valent nodes getting " T)
                (PRIN1 NUMFV T)
                (PRIN1 " free valences" T])

(EXPLAINNOFV
  [LAMBDA (FV)
    (PRIN1 "rings with " T)
    (EXPLAINVL FV])

(EXPLAINNOLOOP
  [LAMBDA (VL)
    (PRIN1 "non-looped " T)
    (EXPLAINNOFV VL])

(EXPLAINCAT
  [LAMBDA (TVL)
    (PRIN1 "catalog entries with " T)
    (EXPLAINVL (CONS (QUOTE 0)
                     TVL])

(EXPLAINATTBIV
  [LAMBDA (BVP STRUC)
    (PRIN1 "structures with " T)
    (PROG (FLG)
          (FOR PR IN BVP WHEN (NOT (ZEROP (CAR PR)))
             DO (AND FLG (PRIN1 ", " T))
                (SETQ FLG T)
                (PRIN1 (CAR PR)
                       T)
                (PRIN1 " bivalents placed on " T)
                (PRIN1 (CDR PR)
                       T)
                (PRIN1 (COND
                         ((EQ (CDR PR)
                              1)
                           " edge")
                         (T " edges"))
                       T)))
    (PRIN1 " of " T)
    (EXPLAIN STRUC])

(EXPLAINVL
  [LAMBDA (VL)
    (PROG (FLG)
          (FOR X IN VL AS I FROM 2 WHEN (NOT (ZEROP X))
             DO (AND FLG (PRIN1 ", " T))
                (SETQ FLG T)
                (PRIN1 X T)
                (PRIN1 " nodes of valence " T)
                (PRIN1 I T])

(EXPLAINBVL
  [LAMBDA (BVP LPP STRUC)
    "structures with "
    [FOR VLPP IN LPP AS NV FROM 2 FOR PR IN VLPP
       DO (AND FLG (PRIN1 ", " T))
          (SETQ FLG T)
          (PRIN1 (CDR PR)
                 T)
          (PRIN1 " of the " T)
          (PRIN1 NV T)
          (PRIN1 " valent nodes getting loops " T)
          (COND
            ((EQ (CLCOUNT (CAR PR))
                 1)
              (PRIN1 " with " T)
              (PRIN1 (CAAAR PR)
                     T)
              (PRIN1 " bivalents " T))
            (T (FOR PR1 IN (CAR PR) DO (AND FLG (PRIN1 ", " T))
                                       (SETQ FLG T)
                                       (PRIN1 (CAR PR1)
                                              T)
                                       (PRIN1 " bivalents on " T)
                                       (PRIN1 (CDR PR1)
                                              T)
                                       (PRIN1 " loops " T]
    (AND FLG (PRIN1 ", " T))
    (SETQ FLG T)
    (EXPLAINATTBIV BVP STRUC])
)
  (RPAQ EXPLAININDENT 0)
  (RPAQ EXPLAINLEVEL 0)
(DEFLIST(QUOTE(
  (MOLECULES EXPLAINATIONMOLECULES)
  (GENMOL EXPLAINGENMOL)
  (RINGS EXPLAINRINGS)
  (STRUCTURESWITHATOMS EXPLAINSTRUCWAT)
  (RINGSKELETONS EXPLAINRINGSKEL)
  (ATTACHFVS EXPLAINATTACFVS)
  (NOFVRINGS EXPLAINNOFV)
  (NOLOOPEDRINGS EXPLAINNOLOOP)
  (CATALOG EXPLAINCAT)
  (ATTACHBIVALENTS EXPLAINATTBIV)
  (ATTACHBIVS&LOOPS EXPLAINBVL)
))(QUOTE EXPLAINATION))

  (ADDTOVAR USERMACROS (⊗ NIL (E (PROG ((EXPLAINLEVEL 100))
                                        (## @))
                                  T))
            (EL (X)
                (EXPLAIN X))
            [EXPLAIN (X)
                     (ORR ((E (PROG ((EXPLAINLEVEL X))
                                    (EXPLAIN (##))
                                    (TERPRI T))
                              T))
                          (E (QUOTE ?]
            (EXPLAINALL NIL (EXPLAIN 100))
            (EXPLAIN NIL (EXPLAIN 2)))
  (ADDTOVAR EDITCOMSA EXPLAIN EXPLAINALL ⊗)
  (ADDTOVAR EDITCOMSL EXPLAIN EL)
STOP